home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / pascalw.exe / lha / NIM.PAS < prev    next >
Pascal/Delphi Source File  |  1990-09-17  |  4KB  |  163 lines
  1. Program Nim( input, output );
  2.  
  3. const
  4.    NROWS = 18;
  5.  
  6. var
  7.    i : integer;
  8.    key : char;
  9.    pile : array[1..3] of integer;
  10.    move : record
  11.       ntaken, pileno : integer;
  12.    end;
  13.  
  14. function GameOver : boolean;
  15. begin
  16.    gameover := ( pile[1] + pile[2] + pile[3] = 0 );
  17. end;
  18.  
  19. procedure display;
  20. var
  21.    start, row, col : integer;
  22. begin
  23.    ClrScr;
  24.    start := 0;
  25.    for col := 1 to 3 do
  26.       if pile[col] > start then
  27.          start := pile[col];
  28.  
  29.    for row := start downto 1 do
  30.       begin
  31.       for col := 1 to 3 do
  32.          if pile[col] >= row then
  33.             write( '  __  ' )
  34.          else
  35.             write( '      ' );         
  36.       writeln;
  37.       end;
  38.  
  39.    if start > 0 then
  40.       writeln( pile[1]:4, pile[2]:6, pile[3]:6 );
  41.  
  42.    writeln;
  43. end;
  44.  
  45. procedure signon;
  46. begin
  47.    writeln;
  48.    writeln( '   *** NIM ***   ' );
  49.    writeln;
  50.    writeln( 'I will set up three piles of coins.' );
  51.    writeln( 'To move, take any number of coins away from any pile.' );
  52.    writeln( 'The player who clears the screen wins.' );
  53.    writeln;
  54.    write( 'Now hit any key to start:' );
  55.  
  56.    while NOT keypressed do
  57.       ;
  58.    key := readkey;
  59.    writeln;
  60. end;
  61.  
  62. Procedure hismove;
  63. var
  64.    ok : boolean;
  65. begin
  66.    repeat
  67.       write( 'Pile (1,2 or 3)? ' );
  68.       readln( move.pileno );
  69.       ok := (move.pileno >= 1) AND (move.pileno <= 3);
  70.       if ok then
  71.          begin
  72.          write( 'Number to take away? ' );
  73.          readln( move.ntaken );
  74.          ok := (move.ntaken >= 1) AND (move.ntaken <= pile[move.pileno]);
  75.          end;
  76.       if not ok then writeln( 'What??' );
  77.    until ok;
  78.    pile[ move.pileno ] := pile[ move.pileno ] - move.ntaken;
  79. end;
  80.  
  81. Procedure mymove;
  82. var
  83.    firstbit, x, i, j : integer;
  84.    bit : array[1..3,1..4] of boolean;
  85.    parity : array[1..4] of boolean;
  86. begin
  87.    for i := 1 to 3 do
  88.       begin
  89.       x := pile[i];
  90.       for j := 4 downto 1 do
  91.          begin
  92.          bit[i, j] := odd(x);
  93.          x := x div 2;
  94.          end;
  95.       end;
  96.  
  97.    for i := 1 to 4 do
  98.       parity[i] := bit[1,i] <> (bit[2,i] <> bit[3,i]);
  99.  
  100.    move.pileno := 1;
  101.    move.ntaken := 0;
  102.    if not ( parity[1] OR parity[2] OR parity[3] OR parity[4] ) then
  103.       begin
  104.       while pile[move.pileno] = 0 do
  105.          move.pileno := move.pileno + 1;
  106.       if pile[move.pileno] = 1 then
  107.          move.ntaken := 1
  108.       else
  109.          move.ntaken := random( pile[move.pileno]-1 ) + 1;
  110.       end
  111.    else
  112.       begin
  113.       firstbit := 1;
  114.       while not parity[firstbit] do
  115.          firstbit := firstbit + 1;
  116.       while not bit[move.pileno, firstbit] do
  117.          move.pileno := move.pileno + 1;
  118.       for i := firstbit to 4 do
  119.          begin
  120.          x := 1;
  121.          for j := 3 downto i do
  122.             x := x * 2;
  123.          if parity[i] then
  124.             if bit[move.pileno, i] then
  125.                move.ntaken := move.ntaken + x
  126.             else
  127.                move.ntaken := move.ntaken - x;
  128.          end;
  129.       end;
  130.    pile[move.pileno] := pile[move.pileno] - move.ntaken;
  131. end;
  132.  
  133. Begin
  134.    Randomize;
  135.    Signon;
  136.    repeat
  137.       for i := 1 to 3 do pile[i] := random(10) + 6;
  138.       display;
  139.       repeat
  140.          hismove;
  141.          if gameover then
  142.             writeln( 'Congratulations ...  You win!' )
  143.          else
  144.             begin
  145.             display;
  146.             Writeln( 'My move is ...' );
  147.             Delay( 1500 );
  148.             mymove;
  149.             display;
  150.             writeln( move.ntaken:3, ' from pile', move.pileno:2 );
  151.             if gameover then
  152.                writeln( '*** I win! ***' );
  153.             writeln;
  154.             end;
  155.       until gameover;
  156.       write( 'Another game? (y/n) ' );
  157.       repeat
  158.          key := readkey;
  159.       until (key = 'n') OR (key = 'y');
  160.    until key = 'n';
  161. End.
  162.  
  163.